Saint Louis City Crime Data - Monthly Reports

Introduction

Washington University Medical Center Redevelopment Corporation is a partnership between BJC Health Care and Washington University School of Medicine and works to improve the quality of life for the neighborhoods surrounding the medical campus. In order to achieve this goal in Forest Park Southeast and the Central West End , WUMCRC has invested millions of dollars toward regenerating the market for private investment in businesses and real estate, enhancing human and social service opportunities, and improving the level of physical and personal security.

One way we work to improve the level of physical & personal security is the analysis and distribution of data. The original source of this crime data is http://slmpd.org/crimereports.shtml. This notebook uses primarily compstatr to access and clean the crime data.

R Markdown

Tidy data

Create an Index

i <- cs_create_index()

Get Data - 2019

update <- cs_last_update()
update <- strsplit(update, " ")[[1]]
c_month <- update[[1]]
c_year <- as.numeric(update[[2]])
yearList19 <- cs_get_data(year = c_year, index = i)

Download Current Month

cs_validate(yearList19, year = 2019)

[1] TRUE

totalCrimes19 <- cs_collapse(yearList19)

print(c_month)

[1] "August"

crimes19 <- cs_extract_month(yearList19, month = "August") 

Clean & Categorize Data - 2019

cs_filter_count removes negative counts. Negative counts, -1, in the count column means that the crime, or charge in this specific observation has either been deemed unfounded, or the crime has been up coded. We do not want to map this data.

Many of the analyses we conduct include comparisons between violent & non-violent crime, comparisons on the amount of crimes happening in each crime cateogy over time, and if crimes occur during the day or at night. The following code ceates variables to conduct these analyses.

cs_crime_cat creates a variable with the names of the crime.

cs_crime creates a logic variable and codes violent crimes as TRUE and non-violent crimes as FALSE

cs_parse_date creates two columns separating the Date Occur variable. The two colums are as follows: one contains the date - month, date, and year, and the other contains the hour and minute. This is used because crimes coded in the most recent month, can contain dates that occured, in previous months or years & in this report we only want to map the crimes that occured in the past month.

filter is a dplyr function that filters out any dates that occur before the our selected date, and also filters out crimes that did not happen in either District 2 or district 5.

mutate adds a variable that codes and labels the days of the week for each crime that occurred, and creates another time of day variable

tidyCrimes19 <- crimes19 %>% 
  cs_filter_count(., var = count) %>%
  cs_filter_crime(., var = crime, "part 1") %>%
  cs_crime_cat(., var = crime, crimeCatNum, "numeric") %>%
  cs_crime_cat(., var = crime, crimeCatName, "string") %>%
  cs_crime(., var = crime, violent, "violent") %>%
  cs_crime(., var = crime, property, "property") %>%
  cs_parse_date(., date_occur, dateVar = dateOcc, timeVar = timeOcc) %>%
  filter(dateOcc >= as.Date("2019-08-01")) %>%
  filter(district == 2 | district == 5) %>%
  mutate(weekday = wday(dateOcc, label = TRUE)) %>%
  mutate(tod = timeOcc)

tidyCrimes19$neighborhood <- as.numeric(tidyCrimes19$neighborhood)

strptime and format takes the new time variable and formats it to a character so that we can determine if the crime occured at day or at night, and creates a second coded variable that labels each observations as day or night based on the newly formated time variable.

select drops the unneeded variables.

cs_missing_XY determines what data does not have x & y coordinates, and therefore cannot be accurately mapped.

cs_replace0 replaces missing x & y coordinates with NA, and drops the missing data.

tidyCrimes19$tod <- strptime(tidyCrimes19$tod, tz = "America/Chicago", "%H:%M")
tidyCrimes19$tod <- format(tidyCrimes19$tod, format = "%H%M%S")

tidyCrimes19 <- tidyCrimes19 %>%
  mutate(., dayNight = ifelse(tod >= "180000" & tod < "600000", "Night", "Day")) %>% 
  dplyr::select(-dateTime, -tod, -flag_crime, -flag_administrative, -flag_unfounded, -flag_cleanup)

tidyCrimes19 <- cs_missingXY(tidyCrimes19, varX = x_coord, varY = y_coord, newVar = missing)
table(tidyCrimes19$missing)

FALSE  TRUE 
  735     4 

tidyCrimes19 <- tidyCrimes19 %>% 
  cs_replace0(., var = x_coord) %>%
  cs_replace0(., var = y_coord) %>% 
  filter(., missing == FALSE) 

Total Crimes 2019 - Clean

totalYearlyCrimes19 <- cs_collapse(yearList19)

tidyTotalCrimes19 <- totalYearlyCrimes19 %>% 
  cs_filter_count(., var = count) %>%
  cs_filter_crime(., var = crime, "part 1") %>%
  cs_crime_cat(., var = crime, crimeCatNum, "numeric") %>%
  cs_crime_cat(., var = crime, crimeCatName, "string") %>%
  cs_crime(., var = crime, violent, "violent") %>%
  cs_crime(., var = crime, property, "property") %>%
  cs_parse_month(., var = coded_month, yearVar = reportYear, month = monthVar) %>%
  cs_parse_date(., date_occur, dateVar = dateOcc, timeVar = timeOcc) %>%
  filter(district == 2 | district == 5) %>%
  mutate(weekday = wday(dateOcc, label = TRUE)) %>%
  mutate(tod = timeOcc) 

tidyTotalCrimes19$neighborhood <- as.numeric(tidyTotalCrimes19$neighborhood)

tidyTotalCrimes19$tod <- strptime(tidyTotalCrimes19$tod, tz = "America/Chicago", "%H:%M")
tidyTotalCrimes19$tod <- format(tidyTotalCrimes19$tod, format = "%H%M%S")

tidyTotalCrimes19 <- tidyTotalCrimes19 %>%
  mutate(., dayNight = ifelse(tod >= "180000" & tod < "600000", "Night", "Day")) %>% 
  dplyr::select(-dateTime, -tod, -flag_crime, -flag_administrative, -flag_unfounded, -flag_cleanup)

tidyTotalCrimes19 <- cs_missingXY(tidyTotalCrimes19, varX = x_coord, varY = y_coord, newVar = missing)
table(tidyTotalCrimes19$missing)

FALSE  TRUE 
 5236    87 

tidyTotalCrimes19 <- tidyTotalCrimes19 %>% 
  cs_replace0(., var = x_coord) %>%
  cs_replace0(., var = y_coord) %>% 
  filter(., missing == FALSE)

rm(totalCrimes18)

object 'totalCrimes18' not found

Get Data - 2018

yearList18 <- cs_get_data(year = 2018, index = i)

Data Preperation

cs_validate(yearList18, year = 2018)

[1] TRUE

Download Last Year’s Month

totalCrimes18 <- cs_collapse(yearList18)
monthCrimes18 <- cs_extract_month(yearList18, month = "August")
rm(yearList18)

Clean & Categorize Data - 2018

tidyMonthCrimes18 <- monthCrimes18 %>% 
  cs_filter_count(., var = count) %>%
  cs_filter_crime(., var = crime, "part 1") %>%
  cs_crime_cat(., var = crime, crimeCatNum, "numeric") %>%
  cs_crime_cat(., var = crime, crimeCatName, "string") %>%
  cs_crime(., var = crime, violent, "violent") %>%
  cs_crime(., var = crime, property, "property") %>%
  cs_parse_date(., date_occur, dateVar = dateOcc, timeVar = timeOcc) %>%
  filter(dateOcc >= as.Date("2018-08-01") & dateOcc <= as.Date("2018-08-31")) %>%
  filter(district == 2 | district == 5) %>%
  mutate(weekday = wday(dateOcc, label = TRUE)) %>%
  mutate(tod = timeOcc)

tidyMonthCrimes18$neighborhood <- as.numeric(tidyMonthCrimes18$neighborhood)

tidyMonthCrimes18$tod <- strptime(tidyMonthCrimes18$tod, tz = "America/Chicago", "%H:%M")
tidyMonthCrimes18$tod <- format(tidyMonthCrimes18$tod, format = "%H%M%S")

tidyMonthCrimes18 <- tidyMonthCrimes18 %>%
  mutate(., dayNight = ifelse(tod >= "180000" & tod < "600000", "Night", "Day")) %>% 
  dplyr::select(-dateTime, -tod, -flag_crime, -flag_administrative, -flag_unfounded, -flag_cleanup)

tidyMonthCrimes18 <- cs_missingXY(tidyMonthCrimes18, varX = x_coord, varY = y_coord, newVar = missing)
table(tidyMonthCrimes18$missing)

FALSE  TRUE 
  747     9 

tidyMonthCrimes18 <- tidyMonthCrimes18 %>% 
  cs_replace0(., var = x_coord) %>%
  cs_replace0(., var = y_coord) %>% 
  filter(., missing == FALSE)

tidyTotalCrimes18 <- totalCrimes18 %>% 
  cs_filter_count(., var = count) %>%
  cs_filter_crime(., var = crime, "part 1") %>%
  cs_crime_cat(., var = crime, crimeCatNum, "numeric") %>%
  cs_crime_cat(., var = crime, crimeCatName, "string") %>%
  cs_crime(., var = crime, violent, "violent") %>%
  cs_crime(., var = crime, property, "property") %>%
  cs_parse_month(., var = coded_month, yearVar = reportYear, month = monthVar) %>%
  cs_parse_date(., date_occur, dateVar = dateOcc, timeVar = timeOcc) %>%
  filter(district == 2 | district == 5) %>%
  mutate(weekday = wday(dateOcc, label = TRUE)) %>%
  mutate(tod = timeOcc) 

tidyTotalCrimes18$neighborhood <- as.numeric(tidyTotalCrimes18$neighborhood)

tidyTotalCrimes18$tod <- strptime(tidyTotalCrimes18$tod, tz = "America/Chicago", "%H:%M")
tidyTotalCrimes18$tod <- format(tidyTotalCrimes18$tod, format = "%H%M%S")

tidyTotalCrimes18 <- tidyTotalCrimes18 %>%
  mutate(., dayNight = ifelse(tod >= "180000" & tod < "600000", "Night", "Day")) %>% 
  dplyr::select(-dateTime, -tod, -flag_crime, -flag_administrative, -flag_unfounded, -flag_cleanup)

tidyTotalCrimes18 <- cs_missingXY(tidyTotalCrimes18, varX = x_coord, varY = y_coord, newVar = missing)
table(tidyTotalCrimes18$missing)

FALSE  TRUE 
 7729   139 

tidyTotalCrimes18 <- tidyTotalCrimes18 %>% 
  cs_replace0(., var = x_coord) %>%
  cs_replace0(., var = y_coord) %>% 
  filter(., missing == FALSE)

rm(totalCrimes18)

Combine 2018 & 2019

augustCrimes <- rbind(tidyMonthCrimes18, tidyCrimes19)

Create Spatial Objects

crimes19_sf <- cs_projectXY(tidyCrimes19, varX = x_coord, varY = y_coord, crs = 102696)
augustCrimes_sf <- cs_projectXY(augustCrimes, varX = x_coord, varY = y_coord, crs = 102696)

Prep for Data by Neighborhood

sa <- c(39,28,38,51,53,54,58,46,47,48,48)
dst2 <- c(7:15,27:29, 39:45,81,82,87,88)
dst5 <- c(38,46:58,78)

Mapping

One way we work to improve the level of physical & personal security is the analysis and distribution of crime data and statistics. The original source of this crime data is http://slmpd.org/crimereports.shtml. This notebook takes the data that was previously cleaned and maps the data.

Load Spatial Data

Coordinates

xyfpse <- c(-90.2679, -90.2423, 38.6176, 38.6334)
xycwe <- c(-90.2759, -90.2368, 38.6286, 38.6552)
xybot <- c(-90.2619, -90.2409, 38.6165, 38.6296)
xydbp <- c(-90.2869, -90.2726, 38.6433, 38.6566)
xysdb <- c(-90.3026, -90.2827, 38.6456, 38.6571)
xywe <- c(-90.3020, -90.2712, 38.6517, 38.6710)
xyvp <- c(-90.2803, -90.2712, 38.6517, 38.6622)
xyac <- c(-90.2744, -90.2609, 38.6505, 38.6661)
xyfp <- c(-90.2648, -90.2543, 38.6493, 38.6655)
xylp <- c(-90.2588, -90.2437, 38.6481, 38.6624)
xyvd <- c(-90.2520, -90.2304, 38.6426, 38.6585)
xymc <- c(-90.2678, -90.2515, 38.6305, 38.6411)
xyctx <- c(-90.2581, -90.2419, 38.6299, 38.6386)
xygrv <- c(-90.2662, -90.2440, 38.6238, 38.6318)
xydst2 <- c(-90.3203, -90.2297, 38.5613, 38.6493)
xydst5 <- c(-90.3080, -90.2132, 38.6273, 38.6962)

Open Street Map from Mapbox - Basemap Tile Imagery

Load External Data

Population Data

load(here("data/nbhd_pop10.rda"))

Spatial

Combine Population & Neighborhood Spatial Data by Police District

Oganize & Filter Crime Data by Neighborhood

dst_2 <- tidyCrimes19 %>% 
  filter(., neighborhood %in% dst2) %>% 
  group_by(., neighborhood) %>%
  count() %>% 
  rename(crimeTotal = n) %>%
  left_join(nbhd_pop10, by = "neighborhood") %>% 
  mutate(., crimeRate = (crimeTotal/pop10)*1000) %>% 
  drop_na()

dst_5 <- tidyCrimes19 %>% 
  filter(., neighborhood %in% dst5) %>% 
  group_by(., neighborhood) %>%
  count() %>% 
  rename(crimeTotal = n) %>%
  left_join(nbhd_pop10, by = "neighborhood") %>% 
  mutate(., crimeRate = (crimeTotal/pop10)*1000) %>% 
  drop_na()

dst_2_pop <- left_join(nhoods_sf, dst_2, by = "neighborhood") %>% 
  st_transform(crs = 102696) %>%
  drop_na() %>% 
  subset(., neighborhood != 88)

dst_5_pop <- left_join(nhoods_sf, dst_5, by = "neighborhood") %>% 
  st_transform(crs = 102696) %>%
  drop_na()

FPSE, BOT, CWE, MC

Map Creation

FPSE

fpse_total_tm <- tm_shape(fpse_tiles) +
  tm_rgb() +
  nhoods_sf %>%
  filter(., neighborhood == 39) %>% 
  tm_shape() +
    tm_fill(col = "#9ecae1", 
            alpha = .5) +
    tm_borders(col = "black", 
               lwd = 2, 
               lty = "dashed") +
  filter(crimes19_sf, 
         neighborhood == 39) %>%
  tm_shape() +
    tm_bubbles(size = .25, 
               col = "crimeCatName", 
               palette = "Set1", 
               title.col = "Part 1 Crimes") +
  tm_credits("© Mapbox, © OpenStreetMap", position = c("left", "BOTTOM")) +
  tm_layout(
    main.title = "FPSE Total Crime - August 2019",
    frame = FALSE,
    legend.bg.color = "white", 
    legend.frame=TRUE,
    legend.outside = TRUE,
    legend.position = c("right", "bottom")) 

fpse_total_tm

fpse_dn_tm <- tm_shape(fpse_tiles) +
  tm_rgb() +
  nhoods_sf %>%
  filter(., neighborhood == 39) %>% 
  tm_shape() +
    tm_fill(col = "#9ecae1", 
            alpha = .5) +
    tm_borders(col = "black", 
               lwd = 2, 
               lty = "dashed") +
  filter(crimes19_sf, 
         neighborhood == 39) %>%
  tm_shape() +
    tm_bubbles(size = .25, 
               col = "dayNight", 
               palette = "-RdBu", 
               title.col = "Time of Crimes") +
  tm_credits("© Mapbox, © OpenStreetMap", position = c("left", "BOTTOM")) +
  tm_layout(
    main.title = "FPSE Time of Crimes - August 2019",
    frame = FALSE,
    legend.bg.color = "white", 
    legend.frame=TRUE,
    legend.outside = TRUE,
    legend.position = c("right", "bottom")) 

fpse_dn_tm

fpse_vlnt_tm <- tm_shape(fpse_tiles) +
  tm_rgb() +
  nhoods_sf %>%
  filter(., neighborhood == 39) %>% 
  tm_shape() +
    tm_fill(col = "#9ecae1", 
            alpha = .5) +
    tm_borders(col = "black", 
               lwd = 2, 
               lty = "dashed") +
  filter(crimes19_sf, 
         neighborhood == 39) %>%
  tm_shape() +
    tm_bubbles(size = .25, 
               col = "violent", 
               palette = "Reds", 
               title.col = "Violent") +
  tm_credits("© Mapbox, © OpenStreetMap", position = c("left", "BOTTOM")) +
  tm_layout(
    main.title = "FPSE Violent Crime - August 2019",
    frame = FALSE,
    legend.bg.color = "white", 
    legend.frame=TRUE,
    legend.outside = TRUE,
    legend.position = c("right", "bottom")) 

fpse_vlnt_tm

crimes19_sf %>%
  filter(neighborhood == 39) %>%
  smooth_map(., bandwidth = 0.5, style = "pretty",
  cover = fpse) -> fpse_densities

  |                                                                                                  
  |                                                                                            |   0%
  |                                                                                                  
  |=========                                                                                   |  10%
  |                                                                                                  
  |============================                                                                |  30%
  |                                                                                                  
  |==============================================                                              |  50%
  |                                                                                                  
  |================================================================                            |  70%
  |                                                                                                  
  |===================================================================================         |  90%
  |                                                                                                  
  |============================================================================================| 100%

fpse_den_tm <- tm_shape(fpse_tiles) +
  tm_rgb() +
  nhoods_sf %>%
  filter(., neighborhood == 39) %>% 
  tm_shape() +
    tm_fill(col = NA, 
            alpha = .5) +
    tm_borders(col = "black", 
               lwd = 2, 
               lty = "dashed") +
  tm_shape(fpse_densities$polygons) +
  tm_fill(col = "level", palette = "BuPu", alpha = .60, 
    title = expression("Crimes per " * km^2)) +
  tm_credits("© Mapbox, © OpenStreetMap", position = c("left", "BOTTOM")) +
  tm_layout(
    main.title = "FPSE Crime Density - August 2019",
    frame = FALSE,
    legend.bg.color = "white", 
    legend.frame=TRUE,
    legend.outside = TRUE,
    legend.position = c("right", "bottom")) 

fpse_den_tm

Grove CID

grove_crimes <- st_intersection(crimes19_sf, grove_cid)

attribute variables are assumed to be spatially constant throughout all geometries

fpse_grove_tm <- tm_shape(grv_tiles) +
  tm_rgb() +
  nhoods_sf %>%
  filter(., neighborhood == 39) %>% 
  tm_shape() +
    tm_borders(col = "black", 
               lwd = 2, 
               lty = "dashed") +
  tm_shape(grove_cid) +
    tm_fill(col = "#9ecae1", 
            alpha = .5) +
    tm_borders(col = "black", 
               lwd = 1, 
               lty = "solid") +
  tm_shape(grove_crimes) +
    tm_bubbles(size = .25, 
               col = "crimeCatName", 
               palette = "Set1", 
               title.col = "Part 1 Crimes") +
  tm_credits("© Mapbox, © OpenStreetMap", position = c("left", "BOTTOM")) +
  tm_layout(
    main.title = "Grove CID Total Crime - August 2019",
    frame = FALSE,
    legend.bg.color = "white", 
    legend.frame=TRUE,
    legend.outside = TRUE,
    legend.position = c("right", "bottom")) 

fpse_grove_tm

CWE

cwe_total_tm <- tm_shape(cwe_tiles) +
  tm_rgb() +
  nhoods_sf %>%
  filter(., neighborhood == 38) %>% 
  tm_shape() +
    tm_fill(col = "#9ecae1", 
            alpha = .5) +
    tm_borders(col = "black", 
               lwd = 2, 
               lty = "dashed") +
  filter(crimes19_sf, 
         neighborhood == 38) %>%
  tm_shape() +
    tm_bubbles(size = .25, 
               col = "crimeCatName", 
               palette = "Set1", 
               title.col = "Part 1 Crimes") +
  tm_credits("© Mapbox, © OpenStreetMap", position = c("left", "BOTTOM")) +
  tm_layout(
    main.title = "CWE Total Crime - August 2019",
    frame = FALSE,
    legend.bg.color = "white", 
    legend.frame=TRUE,
    legend.outside = TRUE,
    legend.position = c("right", "bottom")) 

cwe_total_tm

cwe_dn_tm <- tm_shape(cwe_tiles) +
  tm_rgb() +
  nhoods_sf %>%
  filter(., neighborhood == 38) %>% 
  tm_shape() +
    tm_fill(col = "#9ecae1", 
            alpha = .5) +
    tm_borders(col = "black", 
               lwd = 2, 
               lty = "dashed") +
  filter(crimes19_sf, 
         neighborhood == 38) %>%
  tm_shape() +
    tm_bubbles(size = .25, 
               col = "dayNight", 
               palette = "-RdBu", 
               title.col = "Time of Crimes") +
  tm_credits("© Mapbox, © OpenStreetMap", position = c("left", "BOTTOM")) +
  tm_layout(
    main.title = "CWE Total Crime - August 2019",
    frame = FALSE,
    legend.bg.color = "white", 
    legend.frame=TRUE,
    legend.outside = TRUE,
    legend.position = c("right", "bottom")) 

cwe_dn_tm

cwe_vlnt_tm <- tm_shape(cwe_tiles) +
  tm_rgb() +
  nhoods_sf %>%
  filter(., neighborhood == 38) %>% 
  tm_shape() +
    tm_fill(col = "#9ecae1", 
            alpha = .5) +
    tm_borders(col = "black", 
               lwd = 2, 
               lty = "dashed") +
  filter(crimes19_sf, 
         neighborhood == 38) %>%
  tm_shape() +
    tm_bubbles(size = .25, 
               col = "violent", 
               palette = "Reds", 
               title.col = "Violent") +
  tm_credits("© Mapbox, © OpenStreetMap", position = c("left", "BOTTOM")) +
  tm_layout(
    main.title = "CWE Time of Crimes - August 2019",
    frame = FALSE,
    legend.bg.color = "white", 
    legend.frame=TRUE,
    legend.outside = TRUE,
    legend.position = c("right", "bottom")) 

cwe_vlnt_tm

cwe_densities <- crimes19_sf %>%
  filter(neighborhood == 38) %>%
  smooth_map(., bandwidth = 0.5, style = "pretty",
  cover = cwe)

  |                                                                                                  
  |                                                                                            |   0%
  |                                                                                                  
  |=========                                                                                   |  10%
  |                                                                                                  
  |============================                                                                |  30%
  |                                                                                                  
  |==============================================                                              |  50%
  |                                                                                                  
  |================================================================                            |  70%
  |                                                                                                  
  |===================================================================================         |  90%
  |                                                                                                  
  |============================================================================================| 100%

cwe_den_tm <- tm_shape(cwe_tiles) +
  tm_rgb() +
  nhoods_sf %>%
  filter(., neighborhood == 38) %>% 
  tm_shape() +
    tm_fill(col = NA, 
            alpha = .5) +
    tm_borders(col = "black", 
               lwd = 2, 
               lty = "dashed") +
  tm_shape(cwe_densities$polygons) +
  tm_fill(col = "level", palette = "BuPu", alpha = .60, 
    title = expression("Crimes per " * km^2)) +
  tm_credits("© Mapbox, © OpenStreetMap", position = c("left", "BOTTOM")) +
  tm_layout(
    main.title = "CWE Crime Density- August 2019",
    frame = FALSE,
    legend.bg.color = "white", 
    legend.frame=TRUE,
    legend.outside = TRUE,
    legend.position = c("right", "bottom")) 

cwe_den_tm

Medical Campus

mc_crimes <- st_intersection(crimes19_sf, med_campus)

attribute variables are assumed to be spatially constant throughout all geometries

cwe_mc_tm <- tm_shape(mc_tiles) +
  tm_rgb() +
  nhoods_sf %>%
  filter(., neighborhood == 38) %>% 
  tm_shape() +
    tm_borders(col = "black", 
               lwd = 2, 
               lty = "dashed") +
  tm_shape(med_campus) +
    tm_fill(col = "#9ecae1", 
            alpha = .5) +
    tm_borders(col = "black", 
               lwd = 1, 
               lty = "solid") +
  tm_shape(mc_crimes) +
    tm_bubbles(size = .25, 
               col = "crimeCatName", 
               palette = "Set1", 
               title.col = "Part 1 Crimes") +
  tm_credits("© Mapbox, © OpenStreetMap", position = c("left", "BOTTOM")) +
  tm_layout(
    main.title = "Med. Campus Total Crime - August 2019",
    frame = FALSE,
    legend.bg.color = "white", 
    legend.frame=TRUE,
    legend.outside = TRUE,
    legend.position = c("right", "bottom")) 

cwe_mc_tm

Cortex

ctx_crimes <- st_intersection(crimes19_sf, cortex)

attribute variables are assumed to be spatially constant throughout all geometries

cwe_ctx_tm <- tm_shape(ctx_tiles) +
  tm_rgb() +
  nhoods_sf %>%
  filter(., neighborhood == 38) %>% 
  tm_shape() +
    tm_borders(col = "black", 
               lwd = 2, 
               lty = "dashed") +
  tm_shape(cortex) +
    tm_fill(col = "#9ecae1", 
            alpha = .5) +
    tm_borders(col = "black", 
               lwd = 1, 
               lty = "solid") +
  tm_shape(ctx_crimes) +
    tm_bubbles(size = .25, 
               col = "crimeCatName", 
               palette = "Set1", 
               title.col = "Part 1 Crimes") +
  tm_credits("© Mapbox, © OpenStreetMap", position = c("left", "BOTTOM")) +
  tm_layout(
    main.title = "Cortex Total Crime - August 2019",
    frame = FALSE,
    legend.bg.color = "white", 
    legend.frame=TRUE,
    legend.outside = TRUE,
    legend.position = c("right", "bottom")) 

cwe_ctx_tm

Botanical Heights

bot_total_tm <- tm_shape(bot_tiles) +
  tm_rgb() +
  nhoods_sf %>%
  filter(., neighborhood == 28) %>% 
  tm_shape() +
    tm_fill(col = "#9ecae1", 
            alpha = .5) +
    tm_borders(col = "black", 
               lwd = 2, 
               lty = "dashed") +
  filter(crimes19_sf, 
         neighborhood == 28) %>%
  tm_shape() +
    tm_bubbles(size = .25, 
               col = "crimeCatName", 
               palette = "Set1", 
               title.col = "Part 1 Crimes") +
  tm_credits("© Mapbox, © OpenStreetMap", position = c("left", "BOTTOM")) +
  tm_layout(
    main.title = "Botanical Heights Total Crime - August 2019",
    frame = FALSE,
    legend.bg.color = "white", 
    legend.frame=TRUE,
    legend.outside = TRUE,
    legend.position = c("right", "bottom")) 

bot_total_tm

District 2 Density Maps

dst2_rateMap <- tm_shape(dst2_tiles) +
  tm_rgb() +
  tm_shape(dst_2_pop) +
  tm_polygons(col = "crimeRate",
              palette = "BuPu",
              style = "jenks",
              title = "Crimes per 1,000 Residents") +
  tm_text("neighborhood", shadow=TRUE) +
  tm_layout(
    main.title = "District 2 Crime Rates - August 2019",
    frame = FALSE,
    legend.bg.color = "white", 
    legend.frame=TRUE,
    legend.outside = TRUE,
    legend.position = c("right", "bottom")) 

dst2_rateMap

dst5_rateMap <- tm_shape(dst5_tiles) +
  tm_rgb() +
  tm_shape(dst_5_pop) +
  tm_polygons(col = "crimeRate",
              palette = "BuPu",
              style = "jenks",
              title = "Crimes per 1,000 Residents") +
  tm_text("neighborhood", shadow=TRUE) +
  tm_layout(
    main.title = "District 5 Crime Rates - August 2019",
    frame = FALSE,
    legend.bg.color = "white", 
    legend.frame=TRUE,
    legend.outside = TRUE,
    legend.position = c("right", "bottom")) 

dst5_rateMap

Save Maps

Clean Workspace

rm(fpse_total_tm, fpse_dn_tm, fpse_vlnt_tm, fpse_den_tm, fpse_grove_tm, cwe_total_tm, cwe_dn_tm, cwe_vlnt_tm, cwe_den_tm, cwe_mc_tm, cwe_ctx_tm, bot_total_tm, fpse_tiles, cwe_tiles, bot_tiles, mc_tiles, ctx_tiles, grv_tiles, dst_2, dst_5, dst2_tiles, dst5_tiles)

Tables

FPSE Tables

tidyCrimes19 %>% 
  filter(., neighborhood == 39) %>% 
  group_by(crimeCatName) %>% 
  count() %>% 
  adorn_totals(., "row", name = "Total") %>%
  rename(., "Number of Crimes" = n, "Part 1 Crimes" = crimeCatName) -> fpse_crimeCat

tidyCrimes19 %>% 
  filter(., neighborhood == 39) %>% 
  group_by(weekday) %>% 
  count() %>%
  adorn_totals(., "row", name = "Total") %>%
  rename(., "Number of Crimes" = n, "Day of the Week" = weekday) -> fpse_weekDay

tidyCrimes19 %>% 
  filter(., neighborhood == 39) %>% 
  group_by(violent) %>% 
  count() %>%
  adorn_totals(., "row", name = "Total") %>%
  rename(., "Number of Crimes" = n, "Crimes Against Persons" = violent) -> fpse_violent


tidyCrimes19 %>% 
  filter(., neighborhood == 39) %>% 
  group_by(dayNight) %>% 
  count() %>%
  adorn_totals(., "row", name = "Total") %>%
  rename(., "Number of Crimes" = n, "Time of Day" = dayNight) -> fpse_dayNight

tidyTotalCrimes18 %>% 
  filter(., neighborhood == 39) %>% 
  group_by(monthVar) %>% 
  count(crimeCatName) %>% 
  rename(., "Number of Crimes" = n) %>% 
  pivot_wider(names_from = monthVar, values_from = "Number of Crimes") %>% 
  replace(., is.na(.), 0) %>% 
  rename(., "Part 1 Crimes" = crimeCatName, 
         "January" = "01",
         "February" = "02",
         "March" = "03",
         "April" = "04",
         "May" = "05",
         "June" = "06",
         "July" = "07",
         "August" = "08",
         "September" = "09",
         "October" = "10",
         "November" = "11",
         "December" = "12") %>% 
  adorn_totals(., "col", name = "Total") %>% 
  adorn_totals(., "row", name = "Total") -> fpse_2018

tidyTotalCrimes19 %>% 
  filter(., neighborhood == 39) %>% 
  group_by(monthVar) %>% 
  count(crimeCatName) %>% 
  rename(., "Number of Crimes" = n) %>% 
  pivot_wider(names_from = monthVar, values_from = "Number of Crimes") %>% 
  replace(., is.na(.), 0) %>% 
  rename(., "Part 1 Crimes" = crimeCatName, 
         "January" = "01",
         "February" = "02",
         "March" = "03",
         "April" = "04",
         "May" = "05",
         "June" = "06",
         "July" = "07",
         "August" = "08") %>% 
  adorn_totals(., "col", name = "Total") %>% 
  adorn_totals(., "row", name = "Total") -> fpse_2019

fpse_larcenies <- tidyCrimes19 %>% 
  filter(., neighborhood == 39) %>% 
  filter(., crimeCatNum == 6)

write.csv(fpse_larcenies, file = here("results/fpse/2019/august/larcenies.csv"))

fpse_larcenies %>% 
  group_by(weekday) %>% 
  count() %>%
  adorn_totals(., "row", name = "Total") %>%
  rename(., "Number of Crimes" = n, "Day of the Week" = weekday) -> fpse_larcenies_weekDay

fpse_larcenies %>% 
  group_by(dayNight) %>% 
  count() %>%
  adorn_totals(., "row", name = "Total") %>%
  rename(., "Number of Crimes" = n, "Time of Day" = dayNight) -> fpse_larcenies_dayNight

kable(fpse_crimeCat) %>%
  kable_styling(bootstrap_options = c("striped", "hover"), full_width = F, position = "center") %>% 
  save_kable("fpse_crimCat.jpeg")

kable(fpse_weekDay) %>%
  kable_styling(bootstrap_options = c("striped", "hover"), full_width = F, position = "center") %>% 
  save_kable("fpse_weekDay.jpeg")

kable(fpse_violent) %>%
  kable_styling(bootstrap_options = c("striped", "hover"), full_width = F, position = "center") %>% 
  save_kable("fpse_violent.jpeg")

kable(fpse_dayNight) %>%
  kable_styling(bootstrap_options = c("striped", "hover"), full_width = F, position = "center") %>% 
  save_kable("fpse_dayNight.jpeg")

kable(fpse_2018) %>%
  kable_styling(bootstrap_options = c("striped", "hover"), full_width = F, position = "center") %>% 
  save_kable("fpse_2018.jpeg")

kable(fpse_2019) %>%
  kable_styling(bootstrap_options = c("striped", "hover"), full_width = F, position = "center") %>% 
  save_kable("fpse_2019.jpeg")

kable(fpse_larcenies_weekDay) %>%
  kable_styling(bootstrap_options = c("striped", "hover"), full_width = F, position = "center") %>% 
  save_kable("fpse_larcenies_weekDay.jpeg")

kable(fpse_larcenies_dayNight) %>%
  kable_styling(bootstrap_options = c("striped", "hover"), full_width = F, position = "center") %>% 
  save_kable("fpse_larcenies_dayNight.jpeg")

CWE Tables

kable(cwe_crimeCat) %>%
  kable_styling(bootstrap_options = c("striped", "hover"), full_width = F, position = "center") %>% 
  save_kable("cwe_crimCat.jpeg")

kable(cwe_weekDay) %>%
  kable_styling(bootstrap_options = c("striped", "hover"), full_width = F, position = "center") %>% 
  save_kable("cwe_weekDay.jpeg")

kable(cwe_violent) %>%
  kable_styling(bootstrap_options = c("striped", "hover"), full_width = F, position = "center") %>% 
  save_kable("cwe_violent.jpeg")

kable(cwe_dayNight) %>%
  kable_styling(bootstrap_options = c("striped", "hover"), full_width = F, position = "center") %>% 
  save_kable("cwe_dayNight.jpeg")

kable(cwe_2018) %>%
  kable_styling(bootstrap_options = c("striped", "hover"), full_width = F, position = "center") %>% 
  save_kable("cwe_2018.jpeg")

kable(cwe_2019) %>%
  kable_styling(bootstrap_options = c("striped", "hover"), full_width = F, position = "center") %>% 
  save_kable("cwe_2019.jpeg")

kable(cwe_larcenies_weekDay) %>%
  kable_styling(bootstrap_options = c("striped", "hover"), full_width = F, position = "center") %>% 
  save_kable("cwe_larcenies_weekDay.jpeg")

kable(cwe_larcenies_dayNight) %>%
  kable_styling(bootstrap_options = c("striped", "hover"), full_width = F, position = "center") %>% 
  save_kable("cwe_larcenies_dayNight.jpeg")

head(fpse_2018) 

       Part 1 Crimes January February March April May June July August September October November
  Aggravated Assault       2        2     0     3   7    5    4      3         1       7        0
            Homicide       1        0     0     0   0    0    0      0         0       0        0
             Larceny       5        3     6     7  20    5   13     12        14       9       10
 Motor Vehicle Theft       2        1     2     0   3    3    3      2         2       2        2
            Burgalry       0        1     1     3   0    1    1      1         0       1        0
               Arson       0        0     1     0   0    0    0      0         0       0        0
 December Total
        3    37
        0     1
        3   107
        2    24
        0     9
        0     1

write.csv(fpse_2018, file = here("results/fpse/2019/august/fpse_2018.csv"))

head(fpse_2019)

       Part 1 Crimes January February March April May June July August Total
             Larceny       8       10    14    12   8   20   17     19   108
 Motor Vehicle Theft       3        6     1     2   0    2    7      2    23
             Robbery       1        0     1     1   2    5    2      1    13
  Aggravated Assault       0        3     1     2   2    4    2      0    14
               Arson       0        0     1     0   0    0    1      0     2
            Burgalry       0        0     1     1   0    0    3      1     6

write.csv(fpse_2019, file = here("results/fpse/2019/august/fpse_2019.csv"))

head(cwe_2018)

       Part 1 Crimes January February March April May June July August September October November
  Aggravated Assault       7        0     1     7   6   11    6      4         7       4        4
            Burgalry       4        5     6     7   6   13   10     15         7       9       11
            Homicide       1        0     0     0   0    0    0      0         0       0        0
             Larceny      95       61    52    53  65   90  131     89        75      82       60
 Motor Vehicle Theft       9        6     7     9  12    6    6      5        10      12        6
             Robbery       2        2     8    10   1    8    3      9         6       8        5
 December Total
       10    67
        2    95
        0     1
       53   906
        9    97
        6    68

write.csv(cwe_2018, file = here("results/cwe/2019/august/cwe_2018.csv"))

head(cwe_2019)

       Part 1 Crimes January February March April May June July August Total
  Aggravated Assault       8        4    10     3   8   14    4     10    61
            Burgalry       3        5     5     9  13    7   12     18    72
             Larceny      49       63    65    66  68   60   76     78   525
 Motor Vehicle Theft      12        8     3    10  12   10    5     11    71
             Robbery       5        5     2     6   7    3    4      8    40
               Arson       0        0     1     0   0    0    0      0     1

write.csv(cwe_2019, file = here("results/cwe/2019/august/cwe_2019.csv"))

Graphs/Charts

need to change file save locations

FPSE Graphs

tidyCrimes19 %>% 
  filter(., neighborhood == 39) %>% 
  group_by(weekday) %>% 
  count() %>%
  ggplot(., aes(x=weekday, y=n, group=1)) +
    geom_line(color="blue") +
    geom_point() + 
    xlab("Day of Week") + ylab("Total Crimes") +
    ggtitle("FPSE Total Crimes by Days of the Week") 

tidyCrimes19 %>% 
  filter(., neighborhood == 39) %>% 
  group_by(crimeCatName) %>%
  ggplot(., aes(weekday)) +
    geom_bar(aes(fill = crimeCatName), position=position_dodge()) +
    xlab("Day of Week") + ylab("Total Crimes") +
    ggtitle("FPSE Crimes by Day & Category") + 
    labs(fill = "Part 1 Crimes") +
    scale_fill_brewer(palette = "Spectral")

tidyCrimes19 %>% 
  filter(., neighborhood == 39) %>% 
  group_by(dayNight) %>%
  count() %>% 
  ggplot(., aes(x=dayNight, y=n, fill = dayNight)) +
    geom_bar(stat="identity", position=position_dodge(), colour="black") +
    xlab("Time of Day") + ylab("Total Crimes") +
    ggtitle("FPSE Crimes by Time of Day") + 
    labs(fill = "Time") 

CWE Graphs

tidyCrimes19 %>% 
  filter(., neighborhood == 38) %>% 
  group_by(weekday) %>% 
  count() %>%
  ggplot(., aes(x=weekday, y=n, group=1)) +
    geom_line(color="blue") +
    geom_point() + 
    xlab("Day of Week") + ylab("Total Crimes") +
    ggtitle("CWE Total Crimes by Days of the Week")

tidyCrimes19 %>% 
  filter(., neighborhood == 38) %>% 
  group_by(crimeCatName) %>%
  ggplot(., aes(weekday)) +
    geom_bar(aes(fill = crimeCatName), position=position_dodge()) +
    xlab("Day of Week") + ylab("Total Crimes") +
    ggtitle("CWE Crimes by Day & Category") + 
    labs(fill = "Part 1 Crimes") +
    scale_fill_brewer(palette = "Spectral")

tidyCrimes19 %>% 
  filter(., neighborhood == 38) %>% 
  group_by(dayNight) %>%
  count() %>% 
  ggplot(., aes(x=dayNight, y=n, fill = dayNight)) +
    geom_bar(stat="identity", position=position_dodge(), colour="black") +
    xlab("Time of Day") + ylab("Total Crimes") +
    ggtitle("CWE Crimes by Time of Day") + 
    labs(fill = "Time") 

BOT

tidyCrimes19 %>% 
  filter(., neighborhood == 28) %>% 
  group_by(weekday) %>% 
  count() %>%
  ggplot(., aes(x=weekday, y=n, group=1)) +
    geom_line(color="blue") +
    geom_point() + 
    xlab("Day of Week") + ylab("Total Crimes") +
    ggtitle("BOT Total Crimes by Days of the Week")

ggsave(here("results/graphs/bot_crime_weekday.jpeg"), dpi = 300)

Saving 7.29 x 4.51 in image